In the last decade, underrepresented minority populations in Chicago have been increasingly relegated to lower income areas in the South and West of the City.
#
# all_demos <- readRDS(here::here("data", "all_demos_chi_proj.Rda"))
#
wards.2015 <- readRDS(here::here("data", "wards2015_sf.Rda"))
all_demos <- readRDS(here::here("data", "all_demos_chi.Rda"))
selected_demos <- all_demos %>% filter(id %in% c(2012, 2015, 2017))
wards_selected_demos <- st_join(wards.2015,
st_transform(selected_demos, crs = st_crs(wards.2015))
)
# agr = c(
# "GEOID" = "identity", "NAME" = "identiy", "id"="identity", "medianIncome" = "aggregate",
# "perCapitaIncome" = "aggregate", "population" = "aggregate", "medAgemovedInside" = "aggregate",
# "asian_pct" = "aggregate", "black_pct" = "aggregate", "latinx_pct" = "aggregate", "white_pct" = "aggregate",
# "other_pct" = "aggregate", "below_poverty_pct" = "aggregate", "childMedicaid_pct" = "aggregate",
# "childMedicare_pct" = "aggregate", "takeupMedicare_pct" = "aggregate", "takeupMedicaid_pct" = "aggregate",
# "households_kidsSNAP_pct"="aggregate", "takeupSNAP_pct" = "aggregate", "YAmovesInChi_pct" = "aggregate",
# "movesInChi_pct" = "aggregate", "immigrant_pct" = "aggregate", "renting_pct" = "aggregate",
# "public_transport_pct" = "aggregate", "asianPop" = "aggregate", "belowPovertyPop" = "aggregate",
# "blackPop" = "aggregate", "citizenshipPop" = "aggregate", "femaleChildMedicaid" = "aggregate",
# "femaleChildMedicare" = "aggregate", "femaleMedicaid18_64" = "aggregate", "femaleMedicaid65_up" = "aggregate",
# "femaleMedicare18_64" = "aggregate", "femaleMedicare65_up" = "aggregate", "households" = "aggregate",
# "householdsKidsSNAP","householdsSNAP" = "aggregate", "kidsHealthIns" = "aggregate", "latinxPop" = "aggregate",
# "maleChildMedicaid" = "aggregate", "maleChildMedicare" = "aggregate", "maleMedicaid18_64" = "aggregate",
# "maleMedicaid65_up" = "aggregate", "maleMedicare18_64" = "aggregate", "maleMedicare65_up" = "aggregate",
# "medicaidPop" = "aggregate", "medicarePop" = "aggregate", "mobilityPop" = "aggregate",
# "movedInside20to24" = "aggregate", "movedInside25to29" = "aggregate", "movedInsideCounty" = "aggregate",
# "naturalized" = "aggregate", "noncitizen" = "aggregate", "owners" = "aggregate",
# "publicTransport" = "aggregate", "renterPop" = "aggregate", "renters" = "aggregate", "transportPop" = "aggregate", "whitePop" = "aggregate", "predominant_race" = "aggregate", "max_pct" = "aggregate"
# )
# plot intersection of Census tracts with chicago wards
ggplot(wards_selected_demos) +
# color based on predominant race based on Census, shaded by percentage of that race
geom_sf(aes(fill=medianIncome), lwd = 0) +
scale_fill_dt("diverging", discrete=FALSE, na.value=get_dt_cols("palegrey")) +
scale_alpha(range = c(0.15, 1), guide="none") +
# outline Chicago wards over data
geom_sf(data = wards.2015, color="black", fill=NA) +
# label wards with the most movement
# geom_text_repel(data=wards.2015 %>% filter(ward %in% c(10, 18)),
# aes(x=long, y=lat, label=ward),
# fontface="bold",
# force = 5,
# size = 6,
# direction = "both",
# hjust=0) +
# geom_text_repel(data=wards.2015 %>% filter(ward %in% c(9, 13, 14, 33, 34)),
# aes(x=long, y=lat, label=ward),
# nudge_x = -.35,
# segment.size = 0.5,
# segment.color = get_dt_cols("cocoa"),
# fontface="bold",
# size = 6,
# force = 5,
# direction = "both",
# hjust=0) +
# geom_text_repel(data = wards.2015 %>% filter(ward %in% c(11)),
# aes(x=long, y=lat, label=ward),
# nudge_x = .15,
# segment.size = 0.5,
# segment.color = get_dt_cols("cocoa"),
# fontface="bold",
# size = 6,
# force = 10,
# direction = "both",
# hjust = 1) +
coord_sf(datum = NA) +
theme_map_modest() +
theme(plot.margin = unit(c(20, 0, 0, 0), "pt"),
plot.title = element_text(face = "bold", hjust="0.5", margin = margin(t = 15)),
plot.subtitle = element_text( margin = margin(t = 15)),
plot.caption = element_text(hjust=1)) +
# plot each year separately
facet_wrap( ~ id) + labs(
title = "Latinx Populations in Chicago\nPushed to South, West Neighborhoods",
subtitle = "Chicago Racial and Ethnic Group Movement\nby Census Tract Since 2012 (5 year averages)",
caption = "Data Source: U.S. Census Bureau", fill = "Predominant Race in Tract")
all_wards_all_dates <- readRDS(here::here("data", "all_wards_all_dates.Rda"))
allDatesCount.df <- all_wards_all_dates %>% expand(SIDE_CLEAN, WARD, `APPLICATION TYPE`, count_date) %>%
full_join(all_wards_all_dates) %>% arrange(SIDE_CLEAN, WARD, `APPLICATION TYPE`, count_date) %>%
mutate(
activity_wk = lubridate::as_date(
cut(count_date, breaks = "week", start.on.monday = FALSE, origin = lubridate::origin)),
activity_month = lubridate::as_date(
cut(count_date, breaks = "month", start.on.monday = FALSE, origin = lubridate::origin)),
activity_qtr = lubridate::as_date(
cut(count_date, breaks = "quarter", start.on.monday = FALSE, origin = lubridate::origin))
)
library(lemon)
allDatesCount.df %>%
filter(`APPLICATION TYPE` %in% c("ISSUE", "RENEW")) %>% group_by(SIDE, activity_qtr, `APPLICATION TYPE`) %>%
summarise(active_businesses = sum(active_businesses)) %>%
arrange(activity_qtr, desc(active_businesses), SIDE) %>%
mutate(SIDE_CLEAN = factor(SIDE,levels = rev(unique(SIDE))),
SIDE_CLEAN = ifelse(SIDE_CLEAN == "Far Southwest", "Far Southwest Side",
ifelse(SIDE_CLEAN == "Far Southeast", "Far Southeast Side",
SIDE_CLEAN))) %>%
ggplot(aes(x=activity_qtr, y=active_businesses)) +
geom_bar(aes(x=activity_qtr, y=active_businesses, fill=`APPLICATION TYPE`), stat = "identity", position="dodge", show.legend = FALSE) +
scale_fill_dt() +
# geom_text(aes(label=active_businesses),
# size = 3, position = position_stack(vjust = 0.5), color="white") +
scale_y_continuous(labels = scales::comma) +
scale_x_date(date_labels = "%b %y",
date_breaks = "1 year", limits = c(ymd("2012-01-01"), ymd("2018-12-31"))) +
theme_modest() +
theme(legend.position = c(0.6, 0.9),
legend.direction = "horizontal",
legend.key.size = unit(25, "pt"),
legend.title = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.spacing = unit(2, "lines"),
strip.text = element_text(family="Ledger"),
axis.title.y = element_text(size=rel(1.5), margin=unit(c(0,3,0,0),"lines"), angle=90, family="Ledger"),
axis.text.x = element_text(hjust = 0, angle=-45),
axis.title.x = element_blank(),
plot.margin = unit(c(2,4,2,2),"lines")) + facet_rep_wrap(~ SIDE_CLEAN, repeat.tick.labels=TRUE) +
labs(y="Number of Business Licenses Issued or Renewed", colour="Chicago Council Ward", caption="Data Source: Chicago Open Data Portal", title="New Business Never Returns to Far Southeast and Far Southwest Post-Recession", subtitle = "Steady decline in new business entry post-recession in Chicago areas with lowest economic activity pre-recession", fill="Chicago Area")
# annotate("text", x=lubridate::ymd("2013-01-01"), y = 850000, label="Business renewals dipping in 2013, were balanced by spikes in new business due to EDGE tax credits.")
Immediately post-recession in 2013, the amount of Economic Development for a Growing Economy (EDGE) tax credits granted by Illinois nearly doubled from the prior year, causing a brief spike in new business issuances for every area of the city beyond Central (Loop area), which has experienced fairly constant new business entry since the recession. Thus far, only the West Side of Chicago is approaching 2012 levels of new business, with most other areas of the city remaining fairly constant after EDGE excitement tapered off. In the Far Southeast and Far Southwest Sides, where ecnomic activity (in terms of number of active businesses) was about half the next lowest areas even pre-taper, one must wonder how much growth a neighborhood can experience with a rate of new business entry that has hovered around 500 businesses operating on newly-issued licenses for months. For contrast, the mean number of quarterly new licenses issued in the Central area of the city is just under 700,000, and the mean number of quarterly licenses issued in the Northwest Side is jsut over 85,000.
# filter for business license issuances and renewals, and create a monthly count
bus_licenses %>% filter(!is.na(WARD), active==1, activity_date >= mdy("1/1/2012")) %>%
group_by(activity_month, activity_yr, WARD, SIDE) %>%
summarise(business_count = n()) %>% group_by(WARD, SIDE) %>% arrange(desc(business_count)) %>%
# plot boxplot of median monthly issuances and renewals for each ward
ggplot(aes(x=reorder(reorder(reorder(SIDE, business_count, FUN = median),WARD),business_count, FUN=median), y=business_count)) +
# add comparison line for lowest levels of montly ward business activity
geom_hline(yintercept=25, linetype = "dotted") +
# draw boxplots with color and order determined by Chicago Side area
geom_boxplot(aes(group=reorder(as.factor(WARD), SIDE), fill=as.factor(SIDE)), show.legend = FALSE) +
scale_fill_dt() +
# label each each box by corresponding Ward, just above the median (8 pt)
# geom_text_repel(data = bus_licenses %>% filter(!is.na(WARD), active==1) %>%
# group_by(activity_month, activity_yr, WARD, SIDE) %>%
# summarise(business_count = n()) %>% group_by(SIDE) %>%
# arrange(desc(business_count)) %>%
# summarise(median_issuances = median(business_count)) %>%
# arrange(median_issuances),
# aes(x=as.factor(SIDE), y = median_issuances + 300, group=as.factor(SIDE),
# label=as.factor(SIDE), nudge_x=0.05, direction= "y"),
# color="#6E2C49", fontface="bold", size=5, hjust=0.5) +
# limit scale to 750, (one Loop ward's outliers extend ~1000 above other wards)
# still very clearly the highest even without all outliers visible
scale_y_continuous(breaks = sort(c(seq(0, 750, by=150))), limits = c(0, 750)) +
labs(x="Chicago Council Ward", y="Average Monthly Business Count", caption="Data Source: Chicago Open Data Portal", title="Least New & Surviving Businesses in Far South,\nSouthwest Wards for 5+ Years", subtitle="Since 2012, Far South wards average 26 or less monthly business license issuances and renewals",fill="Chicago Area") +
theme_modest() +
theme(
panel.grid.major.x = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_text( family="Ledger", size=rel(0.60)),
axis.text.y = element_text( margin=unit(c(0,2,2,2), "lines")),
axis.title.y = element_text(margin=unit(c(0,0,2,2), "lines"), size=rel(0.85), angle = 90, family = "Ledger"),
plot.caption = element_text(hjust=1)
) +
annotate("text", x = 7 , y= 370, label="Most West Side business\noccurs in Wards 2 and 27,\nwhich border the Loop.", size=rel(4)) +
annotate("text", x = 9 , y= 735, label="The Central area is comprised\nof Ward 42, the Loop area.", size=rel(4)) +
annotate("text", x = 5 , y= 315, label="South Side business activity\nis concentrated in Kenwood,\n Fuller Park areas bordering\nthe University of Chicago.", size=rel(4)) +
annotate("text", x = 3 , y= 285, label="Ward 12 on the Southwest\nSide bordering Chinatown is\ncharacterized by higher rates\nof business activity than\nits neighbors.", size=rel(4))
# read in turnout and change in turnout by Chicago ward and Chciago Side
turnoutSides <- readRDS(here::here("data", "sides_turnout.Rda"))
turnoutDiff <- readRDS(here::here("data", "wards_turnout.Rda"))
# turnoutDiff %>% group_by(SIDE, WARD) %>% summarise(z = max(TURNOUT)) %>% filter(SIDE == "Far Southwest")
# plot average turnout in 2011 and 2015 for each Chicago Side
ggplot(turnoutSides, aes(x=as.factor(YEAR), y=TURNOUT, group=as.factor(SIDE))) +
geom_line(aes(colour=SIDE), size=1.5, show.legend = FALSE) +
# geom_line(data = filter(turnoutSides, (DIFFERENCE > -0)||(is.na(DIFFERENCE))), aes(colour=SIDE), size=1.5, show.legend=FALSE) +
scale_color_dt() +
# add lines for distribution within each Side at Ward level
geom_line(data = turnoutDiff, aes(group=as.factor(WARD), color=SIDE), size=0.5, alpha=0.35, show.legend = FALSE) +
# label each Side's values in line graphs for both 2011 and 2015
geom_label_repel(data = turnoutSides %>% filter(YEAR == 2011),
aes(label = paste0(SIDE, " - ", TURNOUT, "%"), color = SIDE),
fill=NA,
hjust = "left",
nudge_x = -.15,
force=6,
direction = "y",
xlim= c(-0.5,.965),
fontface = "bold",
label.size = 0,
point.padding = 0.75,
size = rel(5),
show.legend = FALSE,
family="Ledger") +
geom_label_repel(data = turnoutSides %>% filter(YEAR == 2015),
aes(label = paste0(SIDE, " - ", TURNOUT, "%"), color = SIDE),
fill=NA,
hjust = "right",
nudge_x = .25,
force = 5,
direction = "y",
fontface = "bold",
point.padding = 0.75,
xlim=c(2.05,3),
label.size = 0,
size = rel(5),
show.legend = FALSE,
family="Ledger") +
# move x-axis text to top of graph
scale_x_discrete(position = "top") +
# coord_cartesian(ylim=c(23.5, 60)) +
theme_modest() +
theme(axis.text.x.top = element_text(size=rel(1.25), vjust = -8, face="bold"),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
panel.grid.minor=element_blank(),
panel.grid.major=element_blank(),
plot.title =
)+
# plot.subtitle = element_text(hjust=0.35)) +
labs(title="Amid City-Wide Turnout Dropoff, Significantly Higher\nVoter Activation in Far Southwest Side",
subtitle="Voters in the Far Southeast, which has faced de-investment\nas determined by a number of factors, far exceeded other areas' participation\nin the last two City Council elections.",
caption="Source: Chicago Board of Election Commissioners", color="Chicago Area") +
annotate("text", x = 1, y = 25, label = "*Underlying ward trends visualized\nbehind Side trendlines", size=rel(4)) +
annotate("text", x = 0.8, y = 65, label="Ward 19 on the Far Southwest\nSide, which contains the Beverly\nand Morgan Park neighborhoods,\nhad voter turnout of nearly\n75% in the 2011 City Council\nElection.", size=rel(4), hjust=0, color=get_dt_cols("mauve"))
# read in combined school report card and budget dataset
school_data <- readRDS(here::here("data", "combined_school_data.Rda"))
schoolsByWard <- readRDS(here::here("data", "schoolsByWard.Rda"))
schoolsByWard <- schoolsByWard %>% rename("School_ID" = "School.ID",
"Unit_Name" = "Name.of.School",
"Address" = "Street.Address")
# add ward to rows from schoolsByWard document parsed above
school_data <- left_join(school_data,
schoolsByWard %>%
dplyr::select(School_ID, WARD = Ward, NAME_WARD_JOIN = Unit_Name),
by=c("School_ID" = "School_ID")) %>%
dplyr::select(School_ID, WARD, SCHOOL_NAME = `SCHOOL NAME`,
NAME_WARD_JOIN, `Proposed Budget`,
`SCHOOL TOTAL ENROLLMENT`, everything())
# calculate average spend per student
school_data <- school_data %>%
mutate(
# remove commas from enrollment column and make sure it's numeric
`SCHOOL TOTAL ENROLLMENT` = as.numeric(gsub(",","",`SCHOOL TOTAL ENROLLMENT`)),
`Proposed Budget` = as.numeric(`Proposed Budget`),
# calculate a basic average spend based on enrollment and budget for each row
AVG_SPEND_PER_STUDENT = as.numeric(`Proposed Budget` / as.numeric(gsub(",","",`SCHOOL TOTAL ENROLLMENT`))),
# ensure year columns are all numeric
YEAR = as.numeric(YEAR),
PREV_YR = as.numeric(YEAR) - 1,
TWO_YR_PRIOR = as.numeric(YEAR) - 2,
# remove trailing white space from school types column
`SCHOOL TYPE NAME` = str_trim(`SCHOOL TYPE NAME`),
SCHOOL_NAME = str_trim(SCHOOL_NAME),
# make sure all charter schools are included in school types column
`SCHOOL TYPE NAME` = ifelse(str_detect(pattern="C$", `SCHOOL ID (R-C-D-T-S)`),
"CHARTERSCH", `SCHOOL TYPE NAME`)) %>%
dplyr::select(YEAR, PREV_YR, TWO_YR_PRIOR, School_ID, WARD, NAME_WARD_JOIN,
CY_BUDGET = `Proposed Budget`,
SCHOOL_TOTAL_ENROLLMENT = `SCHOOL TOTAL ENROLLMENT`,
AVG_SPEND_PER_STUDENT, everything())
# add Chicago area based on matching generated from Chicago Open Data portal dataset
# and UChicago community-area-to-Side matching
school_data <- left_join(school_data, read_csv(here::here("data", "wardSides.csv")),
by="WARD") %>%
dplyr::select(YEAR, PREV_YR, TWO_YR_PRIOR, School_ID, WARD, SIDE, everything())
# make sure all years have all school types
# school_data %>% distinct(YEAR, `SCHOOL TYPE NAME`)
# create variable of columns to keep in front after modifications
front_cols <- c("YEAR", "School_ID", "WARD", "SIDE", "SCHOOL_NAME", "NAME_WARD_JOIN", "CY_BUDGET", "SCHOOL_TOTAL_ENROLLMENT")
# bin enrollment and spend values for comparison
school_data <- school_data %>%
mutate(
ENROLLMENT_RANGE = cut(SCHOOL_TOTAL_ENROLLMENT,
breaks=c(0, 500, 1000, 1500, 2000, 2500, 3000, 3500, 4000, 4500, 5000, Inf),
labels=c("0-499", "500-999", "1,000-1,499", "1,500-1,999",
"2,000-2,499", "2,500-2,999", "3,000-3,499",
"3,500-3,999", "4,000-4,499", "4,500-4,999", "5,000+"),
ordered_result = TRUE),
SPEND_RANGE = cut(AVG_SPEND_PER_STUDENT,
breaks=c(0, 2500, 5000, 75000, 10000, 12500, 15000, Inf),
labels=c("0-2,499", "2,500-4,999", "5,000-7,499",
"7,500-9,999", "10,000-12,499", "12,500-14,999",
"15,000+"),
ordered_result = TRUE)) %>%
dplyr::select(one_of(front_cols), ENROLLMENT_RANGE, SPEND_RANGE, everything())
# enable mapping by majority race in school
school_data <- left_join(
school_data,
school_data %>% group_by(`SCHOOL ID (R-C-D-T-S)`) %>%
summarise(
White= mean(`SCHOOL - WHITE %`, na.rm=TRUE),
Black= mean(`SCHOOL - BLACK %`, na.rm=TRUE),
Asian= mean(`SCHOOL - ASIAN %`, na.rm=TRUE),
Latinx = mean(`SCHOOL - HISPANIC %`, na.rm=TRUE)) %>%
gather(group_name, pct, -`SCHOOL ID (R-C-D-T-S)`) %>%
group_by(`SCHOOL ID (R-C-D-T-S)`) %>%
# sanity check to make sure all races in output to start before slicing
# arrange(`SCHOOL ID (R-C-D-T-S)`) %>%
slice(which.max(pct)) %>%
dplyr::select(`SCHOOL ID (R-C-D-T-S)`, group_name, pct),
by = c("SCHOOL ID (R-C-D-T-S)")) %>%
dplyr::select(front_cols, ENROLLMENT_RANGE, SPEND_RANGE,
predominant_race = group_name, max_pct = pct, everything())
#########################
## Quasi-Random Plot ##
#########################
school_data %>% group_by(`SCHOOL ID (R-C-D-T-S)`, predominant_race) %>%
summarise(avg_LI_pct = mean(`LOW-INCOME SCHOOL %`, na.rm = TRUE),
school_count = n()) %>%
ggplot(aes(predominant_race, avg_LI_pct, color=factor(predominant_race))) +
geom_quasirandom(varwidth=TRUE, size=3, show.legend = FALSE) +
scale_color_dt("diverging", reverse = TRUE, na.value=get_dt_cols("palegray")) +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
# scale_x_continuous(breaks=c(0, 25, 50, 75, 100)) +
scale_x_discrete(position = "top",
labels = c("Majority Asian Schools", "Majority Black Schools",
"Majority Latinx Schools", "Majority White Schools")) +
theme_modest() +
theme(axis.text.x.top = element_text(size=rel(1.75), vjust = -8, face="bold"),
axis.text.y = element_text(size=rel(1.25), margin=unit(c(0,0,0,3),"lines")),
axis.title.y = element_text(size=rel(1.5), angle = 90, family = "Ledger"),
axis.title.x = element_blank()
# legend.title = element_text(size=rel(2)),
# legend.key.size = unit(35, "pt"),
# legend.text = element_text(size=rel(1.5))
# plot.title = element_text(size=rel(2.5))
) +
labs(title = "Majority Black and Majority Latinx Schools Have Much Higher Percentages of Low Income Students",
x="Predominant Race in School",
y="Percentage of Low Income Students", caption="Data Source: Illinois State Board of Education, Annual Report Cards") +
annotate("text", y = 30, x = 2.4, label = "A handful of Near West Side\nand Wicker Park schools buck\nthe overall trend.", hjust=0.5, size=rel(7), face="bold") +
annotate("segment", x = 2.55, xend = 2.975, y = 33, yend = 40) +
annotate("segment", x = 2.7, xend = 2.975, y = 30, yend = 31) +
annotate("segment", x = 2.05, xend = 2.2, y = 26, yend = 28) +
annotate("text", x = 2.45, y= 18, label="Keller Gifted Magnet Elementary School*", hjust=0.5, size=rel(7), fontface="bold") +
annotate("text", x = 1.3, y= 53, label="Sheridan Math & Science\nAcademy in Chinatown", hjust=0.5, size=rel(7), face="bold") +
annotate("text", x = 1.45, y= 26, label="Rates at South Loop Elementary School\nand Lenart Regional Gifted Center\nElementary School located six blocks from\nthe University of Chicago are likely\nreflective of overall higher median\nincomes in the schools' neighborhoods.", hjust=0.5, size=rel(7), face="bold") +
annotate("segment", x = 1.875, xend = 1.975, y = 30, yend = 33) +
annotate("segment", x = 1.875, xend = 1.975, y = 30, yend = 30.5) +
annotate("text", x=1.65, y = 38, label="Sutherland Elementary School*",hjust=0.5, size=rel(7), fontface="bold") +
annotate("text", x=3.6, y = 80, label="Schools near Humbolt Park and\nO'Hare have comparably high rates\nof low-income White students.",hjust=0.5, size=rel(7), face="bold") +
annotate("text", x = 1.15, y = 5, label = "*Keller Gifted Magnet and Sutherland Elementary Schools in the neighboring Mt. Greenwood and Beverly communities on the Far\nSouthwest Side have two of the smallest differences between white and non-white student percentages across all non-white schools.", hjust=0, size=rel(7), face="bold")
On average over the last 5 school years, non-white schools have served significantly higher percentages of low-income students, as determined by free and reduced lunch designation. It seems to follow that these schools would provide more resources for students, however over the same time period, average spend per student remains roughly the same across schools, with an increase in the spread of spending distribution after each of the two recent funding formula changes.
library(gganimate)
# library(gapminder)
school_data %>% mutate(NONWHITE_PCT = (100 - as.numeric(`SCHOOL - WHITE %`)),
DIFF_NONWHITE = NONWHITE_PCT - as.numeric(`SCHOOL - WHITE %`)) %>%
arrange(desc(predominant_race), DIFF_NONWHITE) %>%
dplyr::select(front_cols, predominant_race, NONWHITE_PCT, DIFF_NONWHITE, everything()) %>%
ggplot(aes(NONWHITE_PCT, AVG_SPEND_PER_STUDENT, frame = as.integer(YEAR))) +
geom_point(alpha = 0.5, show.legend = FALSE, aes(size = `OVERALL AVERAGE CLASS SIZE - SCHOOL`,
colour = predominant_race)) +
scale_size(range = c(2, 12)) +
scale_color_dt("diverging", reverse = TRUE, na.value=get_dt_cols("palegray")) +
enter_fade() +
exit_fade() +
theme_modest() +
theme(
axis.text.y = element_text(margin=unit(c(0,0,0,2),"lines")),
axis.text.x = element_text(margin=unit(c(2,0,0,0),"lines")),
panel.grid.minor.y = element_blank(),
axis.text = element_text(size=rel(0.5)),
axis.title.x = element_text(size=rel(0.75), family = "Ledger"),
plot.subtitle = element_text(size=rel(0.65), hjust = 1),
plot.title = element_text(size=rel(0.90), hjust = .5),
axis.title.y = element_text(size=rel(0.75), angle = 90, family = "Ledger")
) +
# Here comes the gganimate specific bits
labs(subtitle = 'Year: {frame_time}', x = 'Non-White Student Percentage', y = 'Average Spend per Student',
title = "Spread of Spend per Student Increases\nafter 2017, 2018 School Funding Formula Changes") +
# transition_components(`SCHOOL ID (R-C-D-T-S)`, as.integer(YEAR)) +
gganimate::transition_components(time=as.integer(YEAR), enter_length = integer(2),
exit_length = integer(2)) +
ease_aes('sine-in-out')
# all_demos <- readRDS(here::here("data", "all_demos_chi.Rda"))
# wards_w_all_demos <- st_join(wards.2015, st_transform(all_demos, crs = st_crs(wards.2015)), largest=TRUE)
# beg_mid_end_wards_all_demos <- wards_w_all_demos %>% filter(YEAR %in% c(2012, 2015, 2017))
#
# beg_mid_end_wards_all_demos %>% filter(YEAR %in% c(2012, 2015, 2017)) %>%
# ggplot() +
# geom_sf(aes(fill=medianIncome), alpha=0.5) +
# scale_fill_dt("cool", discrete=FALSE, reverse=TRUE, na.value=get_dt_cols("palegray")) +
# geom_sf(aes(color=predominant_race), fill=NA, lwd=3) +
# scale_color_dt("diverging", discrete=TRUE, na.value=get_dt_cols("palegray")) +
# theme_map_modest() +
# facet_wrap(~YEAR)
school_data %>% group_by(YEAR, SIDE) %>%
summarise(median_spend = min(AVG_SPEND_PER_STUDENT)) %>%
ggplot(aes(y=median_spend, x=as.numeric(YEAR))) +
# geom_line(aes(y=AVG_SPEND_PER_STUDENT, x=YEAR)) +
geom_area(aes(group=as.factor(SIDE), fill=SIDE)) +
scale_fill_dt(na.value=get_dt_cols("palegray")) +
theme_modest() +
theme(legend.text = element_text(size=rel(1)),
legend.title = element_text(size=rel(1)),
axis.title.x = element_text(family = "Ledger"),
axis.title.y = element_text(angle = 90, family = "Ledger")
) +
labs(y= "Median Spend per Student", x="Year", caption="Data Source: Chicago Public Schools, Find Your School Budget & Illinois State Board of Education, Annual Report Cards")